library(tidyverse)
library(psych)
library(readxl)
library(lme4)
source("./scripts/max_factors_efa.R")
source("./scripts/reten_fun.R")
source("./scripts/plot_fun.R")
d <- read.csv("/Users/kweisman/Documents/Research (Stanford)/Projects/Dimkid/dimkid/data/children/run-05_2018-08-07_anonymized.csv")[-1]
question_key <- read_excel("/Users/kweisman/Documents/Research (Stanford)/Projects/Dimkid/design/dimkid4yo (spring 2018)/dimkid4yo versions SAVE (4yo version spring 2018).xlsx") %>%
  select(`Question:`, `Clarification (opt.):`, starts_with("v")) %>%
  rename(question_text = `Question:`,
         question_clar = `Clarification (opt.):`) %>%
  gather(version, question, starts_with("v")) %>%
  mutate(version = as.numeric(gsub("v", "", version)),
         capacity = gsub("Can ___s ", "", question_text),
         capacity = gsub("\\?", "", capacity))
d1 <- d %>%
  left_join(question_key) %>%
  select(run:question, question_text:capacity, response:general_comments) %>%
  filter(!is.na(character), !is.na(capacity))
Joining, by = c("version", "question")
d_efa <- d1 %>%
  select(subid_char, capacity, response_num) %>%
  spread(capacity, response_num) %>%
  column_to_rownames("subid_char")

EFA: All

How many factors to retain?

fa.parallel(d_efa)
 A loading greater than abs(1) was detected.  Examine the loadings carefully.The estimated weights for the factor scores are probably incorrect.  Try a different factor extraction method.
An ultra-Heywood case was detected.  Examine the results carefully
Parallel analysis suggests that the number of factors =  4  and the number of components =  3 

VSS(d_efa, rotate = "oblimin")
 A loading greater than abs(1) was detected.  Examine the loadings carefully.The estimated weights for the factor scores are probably incorrect.  Try a different factor extraction method.
 A loading greater than abs(1) was detected.  Examine the loadings carefully.The estimated weights for the factor scores are probably incorrect.  Try a different factor extraction method.
An ultra-Heywood case was detected.  Examine the results carefully

Very Simple Structure
Call: vss(x = x, n = n, rotate = rotate, diagonal = diagonal, fm = fm, 
    n.obs = n.obs, plot = plot, title = title, use = use, cor = cor)
VSS complexity 1 achieves a maximimum of 0.57  with  1  factors
VSS complexity 2 achieves a maximimum of 0.62  with  3  factors

The Velicer MAP achieves a minimum of 0.02  with  1  factors 
BIC achieves a minimum of  -411.19  with  1  factors
Sample Size adjusted BIC achieves a minimum of  -33.88  with  5  factors

Statistics by number of factors 
  vss1 vss2   map dof chisq    prob sqresid  fit RMSEA  BIC SABIC
1 0.57 0.00 0.021 135   208 5.8e-05      14 0.57 0.083 -411    15
2 0.51 0.59 0.022 118   155 1.3e-02      14 0.59 0.067 -386   -14
3 0.48 0.62 0.023 102   115 1.7e-01      12 0.66 0.050 -352   -30
4 0.40 0.61 0.028  87    93 3.1e-01      12 0.66 0.044 -306   -31
5 0.40 0.53 0.033  73    70 5.7e-01      11 0.67 0.028 -264   -34
6 0.38 0.53 0.039  60    53 7.2e-01      11 0.68 0.000 -222   -32
7 0.36 0.46 0.047  48    36 8.9e-01      11 0.67 0.000 -184   -32
8 0.38 0.48 0.055  37    24 9.6e-01      11 0.68 0.000 -146   -29
  complex eChisq  SRMR eCRMS eBIC
1     1.0    301 0.100 0.107 -318
2     1.2    186 0.079 0.090 -355
3     1.5    114 0.062 0.076 -353
4     1.9     81 0.052 0.069 -318
5     2.0     54 0.042 0.061 -281
6     2.1     36 0.035 0.055 -239
7     2.3     23 0.028 0.050 -197
8     2.4     13 0.021 0.042 -157

reten_fun(d_efa, "oblimin")
[1] 5

5 factors

efa5 <- fa(d_efa, nfactors = 5, rotate = "oblimin") %>% fa.sort()
heatmap_fun(efa5)
Joining, by = "capacity"
Joining, by = "factor"

scoresplot_fun(efa5, target = "all")
Ignoring unknown aesthetics: y

itemsplot_fun(efa5, target = "all")
Joining, by = "capacity"
Joining, by = c("capacity", "factor", "order")

4 factors

efa4 <- fa(d_efa, nfactors = 4, rotate = "oblimin") %>% fa.sort()
heatmap_fun(efa4)
Joining, by = "capacity"
Joining, by = "factor"

scoresplot_fun(efa4, target = "all")
Ignoring unknown aesthetics: y

itemsplot_fun(efa4, target = "all")
Joining, by = "capacity"
Joining, by = c("capacity", "factor", "order")

3 factors

efa3 <- fa(d_efa, nfactors = 3, rotate = "oblimin") %>% fa.sort()
heatmap_fun(efa3)
Joining, by = "capacity"
Joining, by = "factor"

scoresplot_fun(efa3, target = "all")
Ignoring unknown aesthetics: y

itemsplot_fun(efa3, target = "all")
Joining, by = "capacity"
Joining, by = c("capacity", "factor", "order")

2 factors

efa2 <- fa(d_efa, nfactors = 2, rotate = "oblimin") %>% fa.sort()
heatmap_fun(efa2)
Joining, by = "capacity"
Joining, by = "factor"

scoresplot_fun(efa2, target = "all")
Ignoring unknown aesthetics: y

itemsplot_fun(efa2, target = "all")
Joining, by = "capacity"
Joining, by = c("capacity", "factor", "order")

EFA: By game

d_efa %>%
  rownames_to_column("subid_char") %>%
  mutate(character = gsub("^.*_", "", subid_char),
         subid = gsub("_.*$", "", subid_char)) %>%
  left_join(d1 %>% distinct(subid, character, game)) %>%
  count(game, character) %>%
  group_by(game) %>%
  mutate(prop = n/sum(n))
Joining, by = c("character", "subid")
Column `character` joining character vector and factor, coercing into character vectorColumn `subid` joining character vector and factor, coercing into character vector
game1 <- d_efa %>%
  rownames_to_column("subid_char") %>%
  mutate(character = gsub("^.*_", "", subid_char),
         subid = gsub("_.*$", "", subid_char)) %>%
  left_join(d1 %>% distinct(subid, character, game)) %>%
  filter(game == 1) %>%
  select(-c(character, subid, game)) %>%
  column_to_rownames("subid_char")
Joining, by = c("character", "subid")
Column `character` joining character vector and factor, coercing into character vectorColumn `subid` joining character vector and factor, coercing into character vector
fa.parallel(game1)
Parallel analysis suggests that the number of factors =  3  and the number of components =  2 

efa_game1 <- fa(game1, nfactors = 3, rotate = "oblimin") %>% fa.sort()
convergence not obtained in GPFoblq. 1000 iterations used.
heatmap_fun(efa_game1)
Joining, by = "capacity"
Joining, by = "factor"

game2 <- d_efa %>%
  rownames_to_column("subid_char") %>%
  mutate(character = gsub("^.*_", "", subid_char),
         subid = gsub("_.*$", "", subid_char)) %>%
  left_join(d1 %>% distinct(subid, character, game)) %>%
  filter(game == 2) %>%
  select(-c(character, subid, game)) %>%
  column_to_rownames("subid_char")
Joining, by = c("character", "subid")
Column `character` joining character vector and factor, coercing into character vectorColumn `subid` joining character vector and factor, coercing into character vector
fa.parallel(game2)
 A loading greater than abs(1) was detected.  Examine the loadings carefully.The estimated weights for the factor scores are probably incorrect.  Try a different factor extraction method.
An ultra-Heywood case was detected.  Examine the results carefully A loading greater than abs(1) was detected.  Examine the loadings carefully.The estimated weights for the factor scores are probably incorrect.  Try a different factor extraction method.
An ultra-Heywood case was detected.  Examine the results carefully
Parallel analysis suggests that the number of factors =  4  and the number of components =  2 

efa_game2 <- fa(game2, nfactors = 4, rotate = "oblimin") %>% fa.sort()
heatmap_fun(efa_game2)
Joining, by = "capacity"
Joining, by = "factor"

Regressions

d_diff <- d1 %>%
  mutate(factor = case_when(
    capacity %in% c("feel happy", "feel sorry", "get lonely",
                    "get sad", "hate someone", "love someone") ~ "HEART",
    capacity %in% c("feel hungry", "feel sick", "feel tired",
                    "get scared", "get thirsty", "smell things") ~ "BODY",
    capacity %in% c("figure things out", "hear", "know stuff",
                    "remember things", "see", "think") ~ "MIND",
    TRUE ~ "NA")) %>%
  group_by(subid, age_years, character, factor) %>%
  summarise(total = sum(response_num)) %>%
  ungroup() %>%
  spread(factor, total) %>%
  mutate(BminH = BODY - HEART,
         BminM = BODY - MIND,
         MminH = MIND - HEART) %>%
  select(subid, age_years, character, BminH, BminM, MminH) %>%
  gather(comparison, diff, c(BminH, BminM, MminH)) %>%
  mutate(comparison = factor(comparison),
         diff2 = diff * 2,
         age_years_cent = scale(age_years, scale = T),
         character = factor(character, levels = c("beetle", "robot")))
contrasts(d_diff$character) <- cbind(robot_GM = c(-1, 1))
ggplot(d_diff, aes(x = diff, fill = character)) +
  facet_grid(character ~ comparison) +
  geom_histogram(binwidth = 1) +
  geom_vline(xintercept = 0, lty = 2, color = "black") +
  theme_bw()

ggplot(d_diff, aes(x = age_years, y = diff, color = character)) +
                 # color = character, fill = character)) +
                 # color = comparison, fill = comparison)) +
  facet_grid(~ comparison) +
  geom_hline(yintercept = 0, lty = 2, color = "darkgray") +
  geom_point(alpha = 0.5) +
  geom_smooth(aes(group = comparison), color = "black",
              method = "lm", alpha = 0.25) +
  theme_bw()

ggplot(d_diff, aes(x = age_years, y = abs(diff), color = character)) +
  # color = character, fill = character)) +
  # color = comparison, fill = comparison)) +
  facet_grid(~ comparison) +
  geom_hline(yintercept = 0, lty = 2, color = "darkgray") +
  geom_point(alpha = 0.5) +
  geom_smooth(aes(group = comparison), color = "black",
              method = "lm", alpha = 0.25) +
  theme_bw()

r_d_diffBminH <- lme4::glmer(abs(diff2) ~ age_years_cent +
                             (1 | subid) + (age_years_cent | character),
                           d_diff %>% filter(comparison == "BminH"),
                           family = "poisson",
                           control = glmerControl(optimizer = "bobyqa"))
summary(r_d_diffBminH)
Generalized linear mixed model fit by maximum likelihood (Laplace
  Approximation) [glmerMod]
 Family: poisson  ( log )
Formula: abs(diff2) ~ age_years_cent + (1 | subid) + (age_years_cent |  
    character)
   Data: d_diff %>% filter(comparison == "BminH")
Control: glmerControl(optimizer = "bobyqa")

     AIC      BIC   logLik deviance df.resid 
   408.2    423.5   -198.1    396.2       88 

Scaled residuals: 
    Min      1Q  Median      3Q     Max 
-1.5898 -0.7534 -0.1284  0.5414  2.5282 

Random effects:
 Groups    Name           Variance  Std.Dev. Corr 
 subid     (Intercept)    0.1462600 0.38244       
 character (Intercept)    0.0157481 0.12549       
           age_years_cent 0.0009871 0.03142  -1.00
Number of obs: 94, groups:  subid, 48; character, 2

Fixed effects:
               Estimate Std. Error z value Pr(>|z|)    
(Intercept)      0.9706     0.1245   7.795 6.45e-15 ***
age_years_cent   0.1537     0.0872   1.762    0.078 .  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Correlation of Fixed Effects:
            (Intr)
age_yrs_cnt -0.236
r_d_diffBminM <- lme4::glmer(abs(diff2) ~ age_years_cent +
                             (1 | subid) + (age_years_cent | character),
                           d_diff %>% filter(comparison == "BminM"),
                           family = "poisson",
                           control = glmerControl(optimizer = "bobyqa"))
summary(r_d_diffBminM)
Generalized linear mixed model fit by maximum likelihood (Laplace
  Approximation) [glmerMod]
 Family: poisson  ( log )
Formula: abs(diff2) ~ age_years_cent + (1 | subid) + (age_years_cent |  
    character)
   Data: d_diff %>% filter(comparison == "BminM")
Control: glmerControl(optimizer = "bobyqa")

     AIC      BIC   logLik deviance df.resid 
   428.5    443.7   -208.2    416.5       88 

Scaled residuals: 
     Min       1Q   Median       3Q      Max 
-1.95124 -0.97732 -0.00804  0.55469  2.77991 

Random effects:
 Groups    Name           Variance Std.Dev. Corr
 subid     (Intercept)    0.270989 0.52057      
 character (Intercept)    0.006126 0.07827      
           age_years_cent 0.018322 0.13536  1.00
Number of obs: 94, groups:  subid, 48; character, 2

Fixed effects:
               Estimate Std. Error z value Pr(>|z|)    
(Intercept)     0.91652    0.11740   7.807 5.87e-15 ***
age_years_cent  0.02916    0.13765   0.212    0.832    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Correlation of Fixed Effects:
            (Intr)
age_yrs_cnt 0.307 
r_d_diffMminH <- lme4::glmer(abs(diff2) ~ age_years_cent +
                             (1 | subid) + (age_years_cent | character),
                           d_diff %>% filter(comparison == "MminH"),
                           family = "poisson",
                           control = glmerControl(optimizer = "bobyqa"))
summary(r_d_diffMminH)
Generalized linear mixed model fit by maximum likelihood (Laplace
  Approximation) [glmerMod]
 Family: poisson  ( log )
Formula: abs(diff2) ~ age_years_cent + (1 | subid) + (age_years_cent |  
    character)
   Data: d_diff %>% filter(comparison == "MminH")
Control: glmerControl(optimizer = "bobyqa")

     AIC      BIC   logLik deviance df.resid 
   407.9    423.2   -197.9    395.9       88 

Scaled residuals: 
    Min      1Q  Median      3Q     Max 
-1.5706 -0.9441 -0.1916  0.7781  2.2496 

Random effects:
 Groups    Name           Variance  Std.Dev.  Corr
 subid     (Intercept)    2.844e-01 5.333e-01     
 character (Intercept)    0.000e+00 0.000e+00     
           age_years_cent 1.060e-17 3.256e-09  NaN
Number of obs: 94, groups:  subid, 48; character, 2

Fixed effects:
               Estimate Std. Error z value Pr(>|z|)    
(Intercept)     0.77742    0.10986   7.076 1.48e-12 ***
age_years_cent -0.08904    0.10278  -0.866    0.386    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Correlation of Fixed Effects:
            (Intr)
age_yrs_cnt 0.033 

Demographics

d %>% distinct(subid) %>% count() %>% data.frame()
   n
1 50
d %>% distinct(subid, gender) %>% count(gender) %>% data.frame()
  gender  n
1      f 17
2      m 11
3   <NA> 22
d %>% distinct(subid, age_years) %>% 
  summarise(mean = mean(age_years, na.rm = T),
            sd = sd(age_years, na.rm = T),
            median = median(age_years, na.rm = T)) %>% data.frame()
      mean        sd   median
1 4.627507 0.4905214 4.665753
d %>% distinct(subid, age_years) %>% 
  ggplot(aes(x = age_years)) +
  geom_histogram(binwidth = 2/12) +
  geom_vline(xintercept = median(d$age_years), lty = 2, color = "blue") +
  theme_bw()

d %>% distinct(subid, ethnicity_collapse) %>% count(ethnicity_collapse) %>% data.frame()
  ethnicity_collapse  n
1                  A  2
2                  C 13
3                 Cj  1
4                  H  1
5                  I  1
6           multiple 10
7               <NA> 22
d %>% distinct(subid, experimenter) %>% count(experimenter) %>% data.frame()
  experimenter  n
1           cx 13
2           kz 17
3           na 20
LS0tCnRpdGxlOiAiRGlta2lkNHlvIgpvdXRwdXQ6IAogIGh0bWxfbm90ZWJvb2s6CiAgICB0b2M6IHRydWUKICAgIHRvY19mbG9hdDogdHJ1ZQotLS0KCmBgYHtyfQpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShwc3ljaCkKbGlicmFyeShyZWFkeGwpCmxpYnJhcnkobG1lNCkKYGBgCgpgYGB7cn0Kc291cmNlKCIuL3NjcmlwdHMvbWF4X2ZhY3RvcnNfZWZhLlIiKQpzb3VyY2UoIi4vc2NyaXB0cy9yZXRlbl9mdW4uUiIpCnNvdXJjZSgiLi9zY3JpcHRzL3Bsb3RfZnVuLlIiKQpgYGAKCmBgYHtyfQpkIDwtIHJlYWQuY3N2KCIvVXNlcnMva3dlaXNtYW4vRG9jdW1lbnRzL1Jlc2VhcmNoIChTdGFuZm9yZCkvUHJvamVjdHMvRGlta2lkL2RpbWtpZC9kYXRhL2NoaWxkcmVuL3J1bi0wNV8yMDE4LTA4LTA3X2Fub255bWl6ZWQuY3N2IilbLTFdCmBgYAoKYGBge3J9CnF1ZXN0aW9uX2tleSA8LSByZWFkX2V4Y2VsKCIvVXNlcnMva3dlaXNtYW4vRG9jdW1lbnRzL1Jlc2VhcmNoIChTdGFuZm9yZCkvUHJvamVjdHMvRGlta2lkL2Rlc2lnbi9kaW1raWQ0eW8gKHNwcmluZyAyMDE4KS9kaW1raWQ0eW8gdmVyc2lvbnMgU0FWRSAoNHlvIHZlcnNpb24gc3ByaW5nIDIwMTgpLnhsc3giKSAlPiUKICBzZWxlY3QoYFF1ZXN0aW9uOmAsIGBDbGFyaWZpY2F0aW9uIChvcHQuKTpgLCBzdGFydHNfd2l0aCgidiIpKSAlPiUKICByZW5hbWUocXVlc3Rpb25fdGV4dCA9IGBRdWVzdGlvbjpgLAogICAgICAgICBxdWVzdGlvbl9jbGFyID0gYENsYXJpZmljYXRpb24gKG9wdC4pOmApICU+JQogIGdhdGhlcih2ZXJzaW9uLCBxdWVzdGlvbiwgc3RhcnRzX3dpdGgoInYiKSkgJT4lCiAgbXV0YXRlKHZlcnNpb24gPSBhcy5udW1lcmljKGdzdWIoInYiLCAiIiwgdmVyc2lvbikpLAogICAgICAgICBjYXBhY2l0eSA9IGdzdWIoIkNhbiBfX19zICIsICIiLCBxdWVzdGlvbl90ZXh0KSwKICAgICAgICAgY2FwYWNpdHkgPSBnc3ViKCJcXD8iLCAiIiwgY2FwYWNpdHkpKQpgYGAKCmBgYHtyfQpkMSA8LSBkICU+JQogIGxlZnRfam9pbihxdWVzdGlvbl9rZXkpICU+JQogIHNlbGVjdChydW46cXVlc3Rpb24sIHF1ZXN0aW9uX3RleHQ6Y2FwYWNpdHksIHJlc3BvbnNlOmdlbmVyYWxfY29tbWVudHMpICU+JQogIGZpbHRlcighaXMubmEoY2hhcmFjdGVyKSwgIWlzLm5hKGNhcGFjaXR5KSkKYGBgCgpgYGB7cn0KZF9lZmEgPC0gZDEgJT4lCiAgc2VsZWN0KHN1YmlkX2NoYXIsIGNhcGFjaXR5LCByZXNwb25zZV9udW0pICU+JQogIHNwcmVhZChjYXBhY2l0eSwgcmVzcG9uc2VfbnVtKSAlPiUKICBjb2x1bW5fdG9fcm93bmFtZXMoInN1YmlkX2NoYXIiKQpgYGAKCgojIEVGQTogQWxsCgojIyBIb3cgbWFueSBmYWN0b3JzIHRvIHJldGFpbj8KCmBgYHtyfQpmYS5wYXJhbGxlbChkX2VmYSkKYGBgCgpgYGB7cn0KVlNTKGRfZWZhLCByb3RhdGUgPSAib2JsaW1pbiIpCmBgYAoKYGBge3J9CnJldGVuX2Z1bihkX2VmYSwgIm9ibGltaW4iKQpgYGAKCiMjIDUgZmFjdG9ycwoKYGBge3J9CmVmYTUgPC0gZmEoZF9lZmEsIG5mYWN0b3JzID0gNSwgcm90YXRlID0gIm9ibGltaW4iKSAlPiUgZmEuc29ydCgpCmBgYAoKYGBge3J9CmhlYXRtYXBfZnVuKGVmYTUpCmBgYAoKYGBge3J9CnNjb3Jlc3Bsb3RfZnVuKGVmYTUsIHRhcmdldCA9ICJhbGwiKQpgYGAKCmBgYHtyLCBmaWcud2lkdGggPSAzLCBmaWcuYXNwID0gMX0KaXRlbXNwbG90X2Z1bihlZmE1LCB0YXJnZXQgPSAiYWxsIikKYGBgCgoKIyMgNCBmYWN0b3JzCgpgYGB7cn0KZWZhNCA8LSBmYShkX2VmYSwgbmZhY3RvcnMgPSA0LCByb3RhdGUgPSAib2JsaW1pbiIpICU+JSBmYS5zb3J0KCkKYGBgCgpgYGB7cn0KaGVhdG1hcF9mdW4oZWZhNCkKYGBgCgpgYGB7cn0Kc2NvcmVzcGxvdF9mdW4oZWZhNCwgdGFyZ2V0ID0gImFsbCIpCmBgYAoKYGBge3IsIGZpZy53aWR0aCA9IDMsIGZpZy5hc3AgPSAxfQppdGVtc3Bsb3RfZnVuKGVmYTQsIHRhcmdldCA9ICJhbGwiKQpgYGAKCgojIyAzIGZhY3RvcnMKCmBgYHtyfQplZmEzIDwtIGZhKGRfZWZhLCBuZmFjdG9ycyA9IDMsIHJvdGF0ZSA9ICJvYmxpbWluIikgJT4lIGZhLnNvcnQoKQpgYGAKCmBgYHtyfQpoZWF0bWFwX2Z1bihlZmEzKQpgYGAKCmBgYHtyfQpzY29yZXNwbG90X2Z1bihlZmEzLCB0YXJnZXQgPSAiYWxsIikKYGBgCgpgYGB7ciwgZmlnLndpZHRoID0gMywgZmlnLmFzcCA9IDF9Cml0ZW1zcGxvdF9mdW4oZWZhMywgdGFyZ2V0ID0gImFsbCIpCmBgYAoKCiMjIDIgZmFjdG9ycwoKYGBge3J9CmVmYTIgPC0gZmEoZF9lZmEsIG5mYWN0b3JzID0gMiwgcm90YXRlID0gIm9ibGltaW4iKSAlPiUgZmEuc29ydCgpCmBgYAoKYGBge3J9CmhlYXRtYXBfZnVuKGVmYTIpCmBgYAoKYGBge3J9CnNjb3Jlc3Bsb3RfZnVuKGVmYTIsIHRhcmdldCA9ICJhbGwiKQpgYGAKCmBgYHtyLCBmaWcud2lkdGggPSAzLCBmaWcuYXNwID0gMX0KaXRlbXNwbG90X2Z1bihlZmEyLCB0YXJnZXQgPSAiYWxsIikKYGBgCgoKCiMgRUZBOiBCeSBnYW1lICMKCmBgYHtyfQpkX2VmYSAlPiUKICByb3duYW1lc190b19jb2x1bW4oInN1YmlkX2NoYXIiKSAlPiUKICBtdXRhdGUoY2hhcmFjdGVyID0gZ3N1YigiXi4qXyIsICIiLCBzdWJpZF9jaGFyKSwKICAgICAgICAgc3ViaWQgPSBnc3ViKCJfLiokIiwgIiIsIHN1YmlkX2NoYXIpKSAlPiUKICBsZWZ0X2pvaW4oZDEgJT4lIGRpc3RpbmN0KHN1YmlkLCBjaGFyYWN0ZXIsIGdhbWUpKSAlPiUKICBjb3VudChnYW1lLCBjaGFyYWN0ZXIpICU+JQogIGdyb3VwX2J5KGdhbWUpICU+JQogIG11dGF0ZShwcm9wID0gbi9zdW0obikpCmBgYAoKCmBgYHtyfQpnYW1lMSA8LSBkX2VmYSAlPiUKICByb3duYW1lc190b19jb2x1bW4oInN1YmlkX2NoYXIiKSAlPiUKICBtdXRhdGUoY2hhcmFjdGVyID0gZ3N1YigiXi4qXyIsICIiLCBzdWJpZF9jaGFyKSwKICAgICAgICAgc3ViaWQgPSBnc3ViKCJfLiokIiwgIiIsIHN1YmlkX2NoYXIpKSAlPiUKICBsZWZ0X2pvaW4oZDEgJT4lIGRpc3RpbmN0KHN1YmlkLCBjaGFyYWN0ZXIsIGdhbWUpKSAlPiUKICBmaWx0ZXIoZ2FtZSA9PSAxKSAlPiUKICBzZWxlY3QoLWMoY2hhcmFjdGVyLCBzdWJpZCwgZ2FtZSkpICU+JQogIGNvbHVtbl90b19yb3duYW1lcygic3ViaWRfY2hhciIpCgpmYS5wYXJhbGxlbChnYW1lMSkKZWZhX2dhbWUxIDwtIGZhKGdhbWUxLCBuZmFjdG9ycyA9IDMsIHJvdGF0ZSA9ICJvYmxpbWluIikgJT4lIGZhLnNvcnQoKQpoZWF0bWFwX2Z1bihlZmFfZ2FtZTEpCmBgYAoKYGBge3J9CmdhbWUyIDwtIGRfZWZhICU+JQogIHJvd25hbWVzX3RvX2NvbHVtbigic3ViaWRfY2hhciIpICU+JQogIG11dGF0ZShjaGFyYWN0ZXIgPSBnc3ViKCJeLipfIiwgIiIsIHN1YmlkX2NoYXIpLAogICAgICAgICBzdWJpZCA9IGdzdWIoIl8uKiQiLCAiIiwgc3ViaWRfY2hhcikpICU+JQogIGxlZnRfam9pbihkMSAlPiUgZGlzdGluY3Qoc3ViaWQsIGNoYXJhY3RlciwgZ2FtZSkpICU+JQogIGZpbHRlcihnYW1lID09IDIpICU+JQogIHNlbGVjdCgtYyhjaGFyYWN0ZXIsIHN1YmlkLCBnYW1lKSkgJT4lCiAgY29sdW1uX3RvX3Jvd25hbWVzKCJzdWJpZF9jaGFyIikKCmZhLnBhcmFsbGVsKGdhbWUyKQplZmFfZ2FtZTIgPC0gZmEoZ2FtZTIsIG5mYWN0b3JzID0gNCwgcm90YXRlID0gIm9ibGltaW4iKSAlPiUgZmEuc29ydCgpCmhlYXRtYXBfZnVuKGVmYV9nYW1lMikKYGBgCgoKIyBSZWdyZXNzaW9ucwoKYGBge3J9CmRfZGlmZiA8LSBkMSAlPiUKICBtdXRhdGUoZmFjdG9yID0gY2FzZV93aGVuKAogICAgY2FwYWNpdHkgJWluJSBjKCJmZWVsIGhhcHB5IiwgImZlZWwgc29ycnkiLCAiZ2V0IGxvbmVseSIsCiAgICAgICAgICAgICAgICAgICAgImdldCBzYWQiLCAiaGF0ZSBzb21lb25lIiwgImxvdmUgc29tZW9uZSIpIH4gIkhFQVJUIiwKICAgIGNhcGFjaXR5ICVpbiUgYygiZmVlbCBodW5ncnkiLCAiZmVlbCBzaWNrIiwgImZlZWwgdGlyZWQiLAogICAgICAgICAgICAgICAgICAgICJnZXQgc2NhcmVkIiwgImdldCB0aGlyc3R5IiwgInNtZWxsIHRoaW5ncyIpIH4gIkJPRFkiLAogICAgY2FwYWNpdHkgJWluJSBjKCJmaWd1cmUgdGhpbmdzIG91dCIsICJoZWFyIiwgImtub3cgc3R1ZmYiLAogICAgICAgICAgICAgICAgICAgICJyZW1lbWJlciB0aGluZ3MiLCAic2VlIiwgInRoaW5rIikgfiAiTUlORCIsCiAgICBUUlVFIH4gIk5BIikpICU+JQogIGdyb3VwX2J5KHN1YmlkLCBhZ2VfeWVhcnMsIGNoYXJhY3RlciwgZmFjdG9yKSAlPiUKICBzdW1tYXJpc2UodG90YWwgPSBzdW0ocmVzcG9uc2VfbnVtKSkgJT4lCiAgdW5ncm91cCgpICU+JQogIHNwcmVhZChmYWN0b3IsIHRvdGFsKSAlPiUKICBtdXRhdGUoQm1pbkggPSBCT0RZIC0gSEVBUlQsCiAgICAgICAgIEJtaW5NID0gQk9EWSAtIE1JTkQsCiAgICAgICAgIE1taW5IID0gTUlORCAtIEhFQVJUKSAlPiUKICBzZWxlY3Qoc3ViaWQsIGFnZV95ZWFycywgY2hhcmFjdGVyLCBCbWluSCwgQm1pbk0sIE1taW5IKSAlPiUKICBnYXRoZXIoY29tcGFyaXNvbiwgZGlmZiwgYyhCbWluSCwgQm1pbk0sIE1taW5IKSkgJT4lCiAgbXV0YXRlKGNvbXBhcmlzb24gPSBmYWN0b3IoY29tcGFyaXNvbiksCiAgICAgICAgIGRpZmYyID0gZGlmZiAqIDIsCiAgICAgICAgIGFnZV95ZWFyc19jZW50ID0gc2NhbGUoYWdlX3llYXJzLCBzY2FsZSA9IFQpLAogICAgICAgICBjaGFyYWN0ZXIgPSBmYWN0b3IoY2hhcmFjdGVyLCBsZXZlbHMgPSBjKCJiZWV0bGUiLCAicm9ib3QiKSkpCgpjb250cmFzdHMoZF9kaWZmJGNoYXJhY3RlcikgPC0gY2JpbmQocm9ib3RfR00gPSBjKC0xLCAxKSkKYGBgCgpgYGB7cn0KZ2dwbG90KGRfZGlmZiwgYWVzKHggPSBkaWZmLCBmaWxsID0gY2hhcmFjdGVyKSkgKwogIGZhY2V0X2dyaWQoY2hhcmFjdGVyIH4gY29tcGFyaXNvbikgKwogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMSkgKwogIGdlb21fdmxpbmUoeGludGVyY2VwdCA9IDAsIGx0eSA9IDIsIGNvbG9yID0gImJsYWNrIikgKwogIHRoZW1lX2J3KCkKYGBgCgpgYGB7ciwgZmlnLndpZHRoID0gMywgZmlnLmFzcCA9IDAuNX0KZ2dwbG90KGRfZGlmZiwgYWVzKHggPSBhZ2VfeWVhcnMsIHkgPSBkaWZmLCBjb2xvciA9IGNoYXJhY3RlcikpICsKICAgICAgICAgICAgICAgICAjIGNvbG9yID0gY2hhcmFjdGVyLCBmaWxsID0gY2hhcmFjdGVyKSkgKwogICAgICAgICAgICAgICAgICMgY29sb3IgPSBjb21wYXJpc29uLCBmaWxsID0gY29tcGFyaXNvbikpICsKICBmYWNldF9ncmlkKH4gY29tcGFyaXNvbikgKwogIGdlb21faGxpbmUoeWludGVyY2VwdCA9IDAsIGx0eSA9IDIsIGNvbG9yID0gImRhcmtncmF5IikgKwogIGdlb21fcG9pbnQoYWxwaGEgPSAwLjUpICsKICBnZW9tX3Ntb290aChhZXMoZ3JvdXAgPSBjb21wYXJpc29uKSwgY29sb3IgPSAiYmxhY2siLAogICAgICAgICAgICAgIG1ldGhvZCA9ICJsbSIsIGFscGhhID0gMC4yNSkgKwogIHRoZW1lX2J3KCkKYGBgCgpgYGB7ciwgZmlnLndpZHRoID0gMywgZmlnLmFzcCA9IDAuNX0KZ2dwbG90KGRfZGlmZiwgYWVzKHggPSBhZ2VfeWVhcnMsIHkgPSBhYnMoZGlmZiksIGNvbG9yID0gY2hhcmFjdGVyKSkgKwogICMgY29sb3IgPSBjaGFyYWN0ZXIsIGZpbGwgPSBjaGFyYWN0ZXIpKSArCiAgIyBjb2xvciA9IGNvbXBhcmlzb24sIGZpbGwgPSBjb21wYXJpc29uKSkgKwogIGZhY2V0X2dyaWQofiBjb21wYXJpc29uKSArCiAgZ2VvbV9obGluZSh5aW50ZXJjZXB0ID0gMCwgbHR5ID0gMiwgY29sb3IgPSAiZGFya2dyYXkiKSArCiAgZ2VvbV9wb2ludChhbHBoYSA9IDAuNSkgKwogIGdlb21fc21vb3RoKGFlcyhncm91cCA9IGNvbXBhcmlzb24pLCBjb2xvciA9ICJibGFjayIsCiAgICAgICAgICAgICAgbWV0aG9kID0gImxtIiwgYWxwaGEgPSAwLjI1KSArCiAgdGhlbWVfYncoKQpgYGAKCmBgYHtyfQpyX2RfZGlmZkJtaW5IIDwtIGxtZTQ6OmdsbWVyKGFicyhkaWZmMikgfiBhZ2VfeWVhcnNfY2VudCArCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgKDEgfCBzdWJpZCkgKyAoYWdlX3llYXJzX2NlbnQgfCBjaGFyYWN0ZXIpLAogICAgICAgICAgICAgICAgICAgICAgICAgICBkX2RpZmYgJT4lIGZpbHRlcihjb21wYXJpc29uID09ICJCbWluSCIpLAogICAgICAgICAgICAgICAgICAgICAgICAgICBmYW1pbHkgPSAicG9pc3NvbiIsCiAgICAgICAgICAgICAgICAgICAgICAgICAgIGNvbnRyb2wgPSBnbG1lckNvbnRyb2wob3B0aW1pemVyID0gImJvYnlxYSIpKQpzdW1tYXJ5KHJfZF9kaWZmQm1pbkgpCmBgYAoKYGBge3J9CnJfZF9kaWZmQm1pbk0gPC0gbG1lNDo6Z2xtZXIoYWJzKGRpZmYyKSB+IGFnZV95ZWFyc19jZW50ICsKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAoMSB8IHN1YmlkKSArIChhZ2VfeWVhcnNfY2VudCB8IGNoYXJhY3RlciksCiAgICAgICAgICAgICAgICAgICAgICAgICAgIGRfZGlmZiAlPiUgZmlsdGVyKGNvbXBhcmlzb24gPT0gIkJtaW5NIiksCiAgICAgICAgICAgICAgICAgICAgICAgICAgIGZhbWlseSA9ICJwb2lzc29uIiwKICAgICAgICAgICAgICAgICAgICAgICAgICAgY29udHJvbCA9IGdsbWVyQ29udHJvbChvcHRpbWl6ZXIgPSAiYm9ieXFhIikpCnN1bW1hcnkocl9kX2RpZmZCbWluTSkKYGBgCgpgYGB7cn0Kcl9kX2RpZmZNbWluSCA8LSBsbWU0OjpnbG1lcihhYnMoZGlmZjIpIH4gYWdlX3llYXJzX2NlbnQgKwogICAgICAgICAgICAgICAgICAgICAgICAgICAgICgxIHwgc3ViaWQpICsgKGFnZV95ZWFyc19jZW50IHwgY2hhcmFjdGVyKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgZF9kaWZmICU+JSBmaWx0ZXIoY29tcGFyaXNvbiA9PSAiTW1pbkgiKSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgZmFtaWx5ID0gInBvaXNzb24iLAogICAgICAgICAgICAgICAgICAgICAgICAgICBjb250cm9sID0gZ2xtZXJDb250cm9sKG9wdGltaXplciA9ICJib2J5cWEiKSkKc3VtbWFyeShyX2RfZGlmZk1taW5IKQpgYGAKCgoKIyBEZW1vZ3JhcGhpY3MKCmBgYHtyfQpkICU+JSBkaXN0aW5jdChzdWJpZCkgJT4lIGNvdW50KCkgJT4lIGRhdGEuZnJhbWUoKQpgYGAKCmBgYHtyfQpkICU+JSBkaXN0aW5jdChzdWJpZCwgZ2VuZGVyKSAlPiUgY291bnQoZ2VuZGVyKSAlPiUgZGF0YS5mcmFtZSgpCmBgYAoKYGBge3J9CmQgJT4lIGRpc3RpbmN0KHN1YmlkLCBhZ2VfeWVhcnMpICU+JSAKICBzdW1tYXJpc2UobWVhbiA9IG1lYW4oYWdlX3llYXJzLCBuYS5ybSA9IFQpLAogICAgICAgICAgICBzZCA9IHNkKGFnZV95ZWFycywgbmEucm0gPSBUKSwKICAgICAgICAgICAgbWVkaWFuID0gbWVkaWFuKGFnZV95ZWFycywgbmEucm0gPSBUKSkgJT4lIGRhdGEuZnJhbWUoKQpgYGAKCmBgYHtyfQpkICU+JSBkaXN0aW5jdChzdWJpZCwgYWdlX3llYXJzKSAlPiUgCiAgZ2dwbG90KGFlcyh4ID0gYWdlX3llYXJzKSkgKwogIGdlb21faGlzdG9ncmFtKGJpbndpZHRoID0gMi8xMikgKwogIGdlb21fdmxpbmUoeGludGVyY2VwdCA9IG1lZGlhbihkJGFnZV95ZWFycyksIGx0eSA9IDIsIGNvbG9yID0gImJsdWUiKSArCiAgdGhlbWVfYncoKQpgYGAKCmBgYHtyfQpkICU+JSBkaXN0aW5jdChzdWJpZCwgZXRobmljaXR5X2NvbGxhcHNlKSAlPiUgY291bnQoZXRobmljaXR5X2NvbGxhcHNlKSAlPiUgZGF0YS5mcmFtZSgpCmBgYAoKYGBge3J9CmQgJT4lIGRpc3RpbmN0KHN1YmlkLCBleHBlcmltZW50ZXIpICU+JSBjb3VudChleHBlcmltZW50ZXIpICU+JSBkYXRhLmZyYW1lKCkKYGBgCgo=